home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Forever 4
/
Atari Forever 4.zip
/
Atari Forever 4.iso
/
SERIE_AI
/
AI_022
/
JAPWORPR
/
KAN_SHOW.GFA
(
.txt
)
< prev
next >
Wrap
GFA-BASIC Atari
|
1998-03-14
|
10KB
|
439 lines
'
' KANJI TEXT DISPLAY. version 1.8
' Programming by M.UTASHIRO 1990/07/31 ver 1.0
' 1990/08/03 ver 1.2
' 1990/08/05 ver 1.5
' 1990/08/07 ver 1.6
' 1990/08/14 ver 1.8
'
'
initial
initial_data
asm_load
mark
explain
key
'
> PROCEDURE asm_load
'
RESTORE asm1
asm1:
DATA $206F,$0004,$226F,$0008,$202F,$000C,$7201,$D1C0
DATA $1091,$5288,$5289,$1091
DATA $D1FC,$0000,$004F,$5289,$5281,$B2BC,$0000,$0011,$66E6
DATA $4E75
'
FOR i%=1 TO 22
READ j%
asm$=asm$+MKI$(j%)
NEXT i%
'
asm%=V:asm$
screen%=XBIOS(2)
'
RETURN
'
> PROCEDURE initial
OPTION BASE 0
GRAPHMODE 1
DEFFILL 1,0
BOUNDARY 1
IF XBIOS(4)<>2
ALERT 1,"SORRY ! |THIS PROGRAM RUNS ONLY |HIGH RESOLUTION. ",1," OK ",l%
SYSTEM
ENDIF
read_hira_font
RETURN
'
> PROCEDURE initial_data
fin%=0 ! FILE EXIST.
maxline%=1000 ! MAX LINE.
max_xposition%=37 ! MAX COLUMN.(+1)
pageline%=15 ! LINE PAR A PAGE.
spacechara%=&H217F ! SPACE CHARACTER JIS CORD.
cr_chara%=&H2120 ! CR CHARACTER JIS CORD.
page_chara%=&H2220 ! PAGE CHARACTER JIS CORD.
end_chara%=&H222F ! END CHARACTER JIS CORD.
'
DIM bun%(max_xposition%,maxline%)
RETURN
'
> PROCEDURE key
'
bun_load
'
DO
tinput%=INP(2)
l$=CHR$(tinput%)
' PRINT AT(1,1);tinput%
' DELAY 1
SELECT tinput%
CASE 0 TO 18
CASE 19 ! CONTROL S : SAVE PICTURE.
pic_save
CASE 20 TO 26
CASE 27 ! ESCAPE
esc_quit
CASE 28 TO 186
CASE 187 ! F1
CASE 188 ! F2
CASE 189 ! F3
CASE 190 ! F4
CASE 191 ! F5
CASE 192 ! F6
CASE 193 ! F7
up_page
CASE 194 ! F8
dn_page
CASE 195 ! F9
CASE 196 ! F10
bun_load
CASE 197 TO 198
CASE 199
clr_home
CASE 200 ! UP ARROW
up_arrow
CASE 201 TO 207
CASE 208 ! DOWN ARROW
dn_arrow
CASE 209 TO 255
ENDSELECT
LOOP
'
RETURN
'
> PROCEDURE bun_load
'
FILESELECT "\*.KAN","",file_1$
'
IF EXIST(file_1$)
ARRAYFILL bun%(),spacechara%
OPEN "I",#1,file_1$
texthead$=INPUT$(32,#1)
max_xposition%=CVI(MID$(texthead$,5,2))
IF max_xposition%<1
max_xposition%=37
ENDIF
IF max_xposition%>37
max_xposition%=37
ENDIF
i%=0
j%=0
i1%=(LOF(#1)-32)/2
FOR j1%=1 TO i1%
bun%(j%,i%)=CVI(INPUT$(2,#1))
d_load%=bun%(j%,i%)
INC j%
IF j%>max_xposition%
INC i%
j%=0
ENDIF
IF i%>maxline%
j1%=i1%
ENDIF
NEXT j1%
CLOSE #1
'
PRINT AT(2,2);" "
PRINT AT(2,2);"FILE NAME = "+file_1$
max_text%=i%
IF j%=0
DEC max_text%
ENDIF
refline%=0
BOUNDARY 0
PBOX 10,55,628,365
BOUNDARY 1
redraw
fin%=1
ENDIF
'
'
RETURN
'
> PROCEDURE redraw
'
PBOX 10,55,36+(max_xposition%*16),365
FOR i%=0 TO 14
offset%=(1600*i%)+4800
FOR j%=0 TO max_xposition%
chara1%=bun%(j%,i%+refline%)
IF chara1%=0 OR chara1%=spacechara% OR chara1%=cr_chara% OR chara1%=page_chara% OR chara1%=end_chara%
chara1%=&H2121
ENDIF
ADD offset%,2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
NEXT j%
NEXT i%
PRINT AT(50,3);RIGHT$(" "+STR$(refline%+1),5)+" to "+RIGHT$(" "+STR$(refline%+15),5)+" / "+RIGHT$(" "+STR$(max_text%+1),5)+" LINES. "
'
RETURN
'
> PROCEDURE mark
'
CLS
ALERT 0,"KANJI TEXT DISPLAY. |version 1.8 by uta's. |",1," OK ",l%
'
RETURN
'
> PROCEDURE esc_quit
'
ALERT 2," QUIT SURE ? ",1," OK |CANCEL",l%
IF l%=1
' EDIT
SYSTEM
ENDIF
'
RETURN
'
> PROCEDURE dn_page
'
IF fin%=1
refline1%=refline%
i%=DIV(refline%,pageline%)
refline2%=(i%+1)*pageline%
IF refline2%+14>maxline%
refline2%=maxline2%-14
ENDIF
IF refline1%<>refline2%
screen_add%=XBIOS(2)
FOR refline%=refline1%+1 TO refline2%
BMOVE screen_add%+6400,screen_add%+4800,22080
i%=14
offset%=27200
FOR j%=0 TO max_xposition%
chara1%=bun%(j%,i%+refline%)
IF chara1%=0 OR chara1%=spacechara% OR chara1%=cr_chara% OR chara1%=page_chara% OR chara1%=end_chara%
chara1%=&H2121
ENDIF
ADD offset%,2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
NEXT j%
PRINT AT(50,3);RIGHT$(" "+STR$(refline%+1),5)+" to "+RIGHT$(" "+STR$(refline%+15),5)+" / "+RIGHT$(" "+STR$(max_text%+1),5)+" LINES. "
NEXT refline%
DEC refline%
ENDIF
ENDIF
'
RETURN
'
> PROCEDURE up_page
'
IF fin%=1
refline1%=refline%
i%=DIV(refline%,pageline%)
j%=MOD(refline%,pageline%)
IF j%<>0
refline2%=i%*pageline%
ELSE
IF i%=0
refline2%=0
ELSE
refline2%=(i%-1)*pageline%
ENDIF
ENDIF
IF refline1%<>refline2%
screen_add%=XBIOS(2)
FOR refline%=refline1%-1 DOWNTO refline2%
BMOVE screen_add%+4800,screen_add%+6400,22080
i%=0
offset%=4800
FOR j%=0 TO max_xposition%
chara1%=bun%(j%,i%+refline%)
IF chara1%=0 OR chara1%=spacechara% OR chara1%=cr_chara% OR chara1%=page_chara% OR chara1%=end_chara%
chara1%=&H2121
ENDIF
ADD offset%,2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
NEXT j%
PRINT AT(50,3);RIGHT$(" "+STR$(refline%+1),5)+" to "+RIGHT$(" "+STR$(refline%+15),5)+" / "+RIGHT$(" "+STR$(max_text%+1),5)+" LINES. "
NEXT refline%
INC refline%
ENDIF
ENDIF
'
RETURN
'
> PROCEDURE up_arrow
'
IF fin%=1
INC refline%
IF refline%+14>maxline%
refline%=maxline%-14
ELSE
BOUNDARY 0
PBOX 11,60,34+(max_xposition%*16),79
BOUNDARY 1
screen_add%=XBIOS(2)
FOR i%=78 TO 60 STEP -2
BMOVE screen_add%+((i%+2)*80),screen_add%+(i%*80),22400
NEXT i%
i%=14
offset%=(1600*i%)+4800
FOR j%=0 TO max_xposition%
chara1%=bun%(j%,i%+refline%)
IF chara1%=0 OR chara1%=spacechara% OR chara1%=cr_chara% OR chara1%=page_chara% OR chara1%=end_chara%
chara1%=&H2121
ENDIF
ADD offset%,2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
NEXT j%
PRINT AT(50,3);RIGHT$(" "+STR$(refline%+1),5)+" to "+RIGHT$(" "+STR$(refline%+15),5)+" / "+RIGHT$(" "+STR$(max_text%+1),5)+" LINES. "
ENDIF
ENDIF
'
RETURN
'
> PROCEDURE dn_arrow
'
IF fin%=1
DEC refline%
IF refline%<0
refline%=0
ELSE
BOUNDARY 0
PBOX 11,340,34+(max_xposition%*16),359
BOUNDARY 1
screen_add%=XBIOS(2)
FOR i%=58 TO 76 STEP 2
BMOVE screen_add%+((i%-2)*80),screen_add%+(i%*80),22400
NEXT i%
i%=0
offset%=4800
FOR j%=0 TO max_xposition%
chara1%=bun%(j%,i%+refline%)
IF chara1%=0 OR chara1%=spacechara% OR chara1%=cr_chara% OR chara1%=page_chara% OR chara1%=end_chara%
chara1%=&H2121
ENDIF
ADD offset%,2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
NEXT j%
PRINT AT(50,3);RIGHT$(" "+STR$(refline%+1),5)+" to "+RIGHT$(" "+STR$(refline%+15),5)+" / "+RIGHT$(" "+STR$(max_text%+1),5)+" LINES. "
ENDIF
ENDIF
'
RETURN
'
> PROCEDURE clr_home
'
IF fin%=1
refline%=0
redraw
ENDIF
'
RETURN
'
> PROCEDURE read_hira_font
'
PRINT
PRINT " FONT LOADING..."
'
DIM c$(&H3000)
IF EXIST(DIR$(0)+"\KANJI3.FNT")
OPEN "I",#1,DIR$(0)+"\KANJI3.FNT"
'
FOR i%=&H120 TO &H22F
IF MOD(i%,&H100)=&H80
i%=i%+&HA0
ENDIF
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H330 TO &H37F
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H420 TO &H47F
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H520 TO &H57F
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H620 TO &H65F
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H720 TO &H77F
c$(i%)=INPUT$(32,#1)
NEXT i%
'
FOR i%=&H1020 TO &H2F5F
IF MOD(i%,&H100)=&H80
i%=i%+&HA0
ENDIF
c$(i%)=INPUT$(32,#1)
NEXT i%
'
CLOSE #1
ELSE
ALERT 3,"KANJI FONT |(KANJI3.FNT) |NOT EXIST. ",1," QUIT ",l%
' EDIT
SYSTEM
ENDIF
RETURN
'
> PROCEDURE pic_save
'
IF fin%=1
BOUNDARY 0
DEFFILL 1,0
PBOX 10,378,628,397
BOUNDARY 1
PRINT AT(2,24);"INPUT FILE NAME ";
INPUT file_pic$
PRINT AT(2,24);" "
file_pic$=LEFT$(file_pic$,8)+".PI3"
PRINT AT(2,2);" "
PRINT AT(50,3);" "
SGET pic$
OPEN "O",#2,file_pic$
PRINT #2,pic$;
CLOSE #2
PRINT AT(2,2);"PICTURE SAVED. FILE NAME = "+file_pic$
~INP(2)
PRINT AT(2,2);" "
PRINT AT(2,2);"FILE NAME = "+file_1$
explain
redraw
ENDIF
'
RETURN
'
> PROCEDURE explain
'
RESTORE explain_data
'
explain_data:
DATA 2346,2337,2127,4130,2121,2346,2338,2127,3C21,2121,2346,2331,2330,2127
DATA 4649,397E,2121,222D,2127,2344,234F,2357,234E,2121,222C,2127,2355,2350
DATA 2121,2121,2121,2121,2345,2353,2343,2127,3D2A,4E3B,0
'
j%=0
DO
READ l$
chara1%=VAL("&H"+l$)
EXIT IF chara1%=0
offset%=(80*380)+(j%*2)+2
asm%=V:asm$
~C:asm%(L:screen%,L:V:c$(chara1%-&H2000),L:offset%)
INC j%
LOOP
'
GRAPHMODE 3
BOUNDARY 0
DEFFILL 1,2,8
PBOX 10,378,628,397
GRAPHMODE 1
BOUNDARY 1
DEFFILL 1,0
'
RETURN
'